home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / nrpas13.arc / SIMP2.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-01  |  1KB  |  41 lines
  1. PROCEDURE simp2(a: glmpbynp; m,n,mp,np: integer;
  2.       l2: glmparray; nl2: integer; VAR ip: integer;
  3.       kp: integer; VAR q1: real);
  4. (* Programs using routine SIMP2 must define the types
  5. TYPE
  6.    glmpbynp = ARRAY [1..mp,1..np] OF real;
  7.    glmparray = ARRAY [1..mp] OF integer;
  8. in the main routine. *)
  9. LABEL 2,6,99;
  10. VAR
  11.    k,ii,i: integer;
  12.    qp,q0,q: real;
  13. BEGIN
  14.    ip := 0;
  15.    IF (nl2 < 1) THEN GOTO 99;
  16.    FOR i := 1 TO nl2 DO BEGIN
  17.       IF (a[l2[i]+1,kp+1] < 0.0) THEN GOTO 2
  18.    END;
  19.    GOTO 99;
  20. 2:   q1 := -a[l2[i]+1,1]/a[l2[i]+1,kp+1];
  21.    ip := l2[i];
  22.    IF ((i+1) > nl2) THEN GOTO 99;
  23.    FOR i := i+1 TO nl2 DO BEGIN
  24.       ii := l2[i];
  25.       IF (a[ii+1,kp+1] < 0.0) THEN BEGIN
  26.          q := -a[ii+1,1]/a[ii+1,kp+1];
  27.          IF (q < q1) THEN BEGIN
  28.             ip := ii;
  29.             q1 := q
  30.          END ELSE IF (q = q1) THEN BEGIN
  31.             FOR k := 1 TO n DO BEGIN
  32.                qp := -a[ip+1,k+1]/a[ip+1,kp+1];
  33.                q0 := -a[ii+1,k+1]/a[ii+1,kp+1];
  34.                IF (q0 <> qp) THEN GOTO 6
  35.             END;
  36. 6:            IF (q0 < qp) THEN ip := ii
  37.          END
  38.       END
  39.    END;
  40. 99:   END;
  41.